home *** CD-ROM | disk | FTP | other *** search
/ JCSM Shareware Collection 1996 September / JCSM Shareware Collection (JCS Distribution) (September 1996).ISO / prgtools / euphor13.zip / LW.EX < prev    next >
Text File  |  1995-05-16  |  7KB  |  323 lines
  1.                ------------------
  2.                -- Language War --
  3.                ------------------
  4. -- See lw.doc for a complete description of how to play.
  5. -- See lw.sum for a brief summary of the commands.
  6.  
  7. -- This is based on a space war game developed in 1979 for the TRS-80
  8. -- by David A. Craig with assistance from Robert H. Craig.
  9. -- This program is being placed in the Public Domain.
  10. -- No rights are reserved - you are encouraged to modify it
  11. -- and redistribute it, along with the Public Domain Edition of Euphoria.
  12. -- The sound and graphics are a bit dated. We're sure you can do 
  13. -- much better! 
  14.  
  15. -- "without type_check" would speed things up, but it doesn't seem necessary.
  16.  
  17. type file_number(integer x)
  18.     return x >= -1
  19. end type
  20.  
  21. file_number sum_no
  22. object line
  23.  
  24. include graphics.e
  25. include vars.e
  26. include screen.e
  27.  
  28. -- display summary file
  29. sum_no = open("lw.sum", "r")
  30. if sum_no != -1 then
  31.     set_bk_color(BLUE)
  32.     set_color(WHITE)
  33.     clear_screen()
  34.     while 1 do
  35.     line = gets(sum_no)
  36.     if atom(line) then
  37.         exit
  38.     end if
  39.     puts(1, line)
  40.     end while
  41. end if
  42.  
  43. include sched.e
  44. include soundeff.e
  45. include display.e
  46. include damage.e
  47. include weapons.e
  48. include commands.e
  49. include emove.e
  50. include enemy.e
  51.  
  52. type energy_source(integer x)
  53.     return x = G_PL or x = G_BS
  54. end type
  55.  
  56. procedure setpb(pb_row row, energy_source stype)
  57. -- initialize a planet or a base
  58.  
  59.     g_index r, c, ri, ci
  60.     h_coord x, xi
  61.     v_coord y, yi
  62.     boolean unique
  63.  
  64.     -- choose a quadrant
  65.     pb[row][P_TYPE] = stype
  66.     r = rand(G_SIZE)
  67.     c = rand(G_SIZE)
  68.     pb[row][P_QR] = r
  69.     pb[row][P_QC] = c
  70.     
  71.     pb[row][P_EN] = (rand(250) + rand(250)) * 50 + 30000
  72.     galaxy[r][c][stype] = galaxy[r][c][stype] + 1
  73.  
  74.     -- choose a position in the quadrant
  75.     while TRUE do
  76.     if stype = G_PL then
  77.         x = rand(HSIZE - length(PLANET_MIDDLE) - 2*length(EUPHORIA_L)) 
  78.         + length(EUPHORIA_L)
  79.         y = rand(VSIZE-4) + 1
  80.     else
  81.         x = rand(HSIZE - length(BASE) - 2*length(EUPHORIA_L))  
  82.         + length(EUPHORIA_L)
  83.         y = rand(VSIZE-3) + 1
  84.         pb[row][P_POD] = 1
  85.         pb[row][P_TORP] = rand(7) + 8
  86.     end if
  87.     pb[row][P_X] = x
  88.     pb[row][P_Y] = y
  89.  
  90.     -- make sure position doesn't overlap another planet or base
  91.     unique = TRUE
  92.     for i = 1 to row - 1 do
  93.         ri = pb[i][P_QR]
  94.         ci = pb[i][P_QC]
  95.         if r = ri and c = ci then
  96.         -- in the same quadrant
  97.         xi = pb[i][P_X]
  98.         if x >= xi - length(PLANET_MIDDLE) and
  99.            x <= xi + length(PLANET_MIDDLE) then
  100.             yi = pb[i][P_Y]
  101.             if y >= yi-2 and y <= yi+2 then
  102.             unique = FALSE
  103.             exit
  104.             end if
  105.         end if
  106.         end if
  107.     end for
  108.     if unique then
  109.         exit
  110.     end if
  111.     end while
  112. end procedure
  113.  
  114.  
  115. procedure init()
  116. -- initialize
  117.     g_index r, c
  118.  
  119.     wrap(0)
  120.     ship = {{EUPHORIA_L, EUPHORIA_R}, -- Euphoria
  121.        {KRC_L,       KRC_R},      -- K&R C
  122.        {ANC_L,       ANC_R},      -- ANSI C
  123.        {CPP_L,       CPP_R},      -- C++
  124.        {BASIC_L,     BASIC_R},    -- BASIC
  125.        {FORTRAN_L,   FORTRAN_R}}  -- FORTRAN
  126.  
  127.     otype = {"EUPHORIA",
  128.          "C",
  129.          "ANSI C",
  130.          "C++",
  131.          "BASIC",
  132.          "FORTRAN",
  133.          "PLANET",
  134.          "BASE"}
  135.  
  136.     -- initial waiting time between activations
  137.     wait = {0.45, -- KEYB
  138.         0.67, -- EMOVE
  139.          6.0, -- LIFE
  140.     INACTIVE, -- DEAD
  141.     INACTIVE, -- BSTAT
  142.     INACTIVE, -- FIRE
  143.          2.3, -- MOVE
  144.     INACTIVE, -- MESSAGE
  145.     INACTIVE, -- DAMAGE
  146.     INACTIVE} -- ENTER
  147.  
  148.     -- early activation tolerance
  149.     eat = {1.0,   -- KEYB
  150.        .04,   -- EMOVE
  151.        .20,   -- LIFE
  152.        .30,   -- DEAD
  153.        .30,   -- BSTAT
  154.        .20,   -- FIRE
  155.        .30,   -- MOVE
  156.        .20,   -- MESSAGE
  157.        .10,   -- DAMAGE
  158.        .30}   -- ENTER
  159.  
  160.     tcb = repeat(2, NTASKS)
  161.     tcb[TASK_EMOVE] = 1 -- task emove scheduled to go first
  162.     sched(TASK_BSTAT, 1 + rand(300))
  163.     sched(TASK_ENTER, 1 + rand(60))
  164.     sched(TASK_DAMAGE, INACTIVE)
  165.     sched(TASK_DEAD, INACTIVE)
  166.     scanon = FALSE
  167.  
  168.     -- blank lower portion
  169.     set_bk_color(WHITE)
  170.     set_color(BLACK)
  171.     for i = WARP_LINE to WARP_LINE + 2 do
  172.     position(i, 1)
  173.     puts(CRT, repeat(' ', 80))
  174.     end for
  175.  
  176.     -- set number of objects in the galaxy
  177.     nobj = {1,  -- Euphoria (must be 1)
  178.        40,  -- regular K&R C ships
  179.         9,  -- ANSI C ships
  180.         1,  -- C++
  181.        50,  -- BASIC ships
  182.        20,  -- Fortran ships
  183.        NPLANETS,  -- planets
  184.        NBASES}    -- bases
  185.  
  186.     quadrant[EUPHORIA][Q_TYPE] = G_EU
  187.     quadrant[EUPHORIA][Q_DEFL] = 3
  188.     ds = repeat(DEFLECTOR, 3)
  189.     quadrant[EUPHORIA][Q_TORP] = 5
  190.     ts = repeat(TORPEDO, 5)
  191.     ps = {POD}
  192.     quadrant[EUPHORIA][Q_EN] = 30000
  193.     wlimit = 5
  194.     curwarp = 4
  195.     curdir = 1
  196.     exi = 3
  197.     eyi = 0
  198.     truce_broken = FALSE
  199.     qrow = 1
  200.     qcol = 1
  201.     stext()
  202.     nchars = 0
  203.  
  204.     -- initialize galaxy sequence
  205.     galaxy = repeat(repeat(repeat(0, NTYPES), G_SIZE), G_SIZE)
  206.     for i = G_KRC to G_FOR do
  207.     for j = 1 to nobj[i] do
  208.         r = rand(G_SIZE)
  209.         c = rand(G_SIZE)
  210.         galaxy[r][c][i] = galaxy[r][c][i] + 1
  211.     end for
  212.     end for
  213.  
  214.     -- initialize planet/base sequence
  215.     for i = 1 to nobj[G_BS] do
  216.     setpb(i, G_BS)
  217.     end for
  218.     for i = nobj[G_BS]+1 to PROWS do
  219.     setpb(i, G_PL)
  220.     end for
  221.     esymr = EUPHORIA_R
  222.     esyml = EUPHORIA_L
  223.     esym = EUPHORIA_R
  224.     quadrant[EUPHORIA][Q_X] = HSIZE - length(esym) + 1
  225.     quadrant[EUPHORIA][Q_Y] = VSIZE
  226.     quadrant[EUPHORIA][Q_UNDER] = "   "
  227.     qrow = pb[1][P_QR]
  228.     qcol = gmod(pb[1][P_QC] - 1)
  229.     bstat = TRUCE
  230.     reptime[1..NSYS] = 0
  231.     ndmg = 0
  232.     wait[TASK_DAMAGE] = INACTIVE
  233.     shuttle = FALSE
  234.     set_bk_color(BLACK)
  235.     set_color(WHITE)
  236.     BlankScreen(TRUE)  -- blank upper portion
  237. end procedure
  238.  
  239. procedure trek()
  240. -- Language Wars Main Routine
  241.  
  242.     natural nk
  243.  
  244.     init()
  245.     current_task = TASK_FIRE
  246.     if level = 'n' then
  247.     wait[TASK_FIRE] = 3.0 -- novice level
  248.     else
  249.     wait[TASK_FIRE] = 1.0 -- expert level
  250.     end if
  251.     gameover = FALSE
  252.  
  253.     while not gameover do
  254.     sched(current_task, wait[current_task])
  255.     current_task = next_task()
  256.  
  257.     if current_task = TASK_KEYB then
  258.         task_keyb()
  259.  
  260.     elsif current_task = TASK_FIRE then
  261.         task_fire()
  262.  
  263.     elsif current_task = TASK_EMOVE then
  264.         task_emove()
  265.  
  266.     elsif current_task = TASK_LIFE then
  267.         task_life()
  268.  
  269.     elsif current_task = TASK_MOVE then
  270.         task_move()
  271.  
  272.     elsif current_task = TASK_MESSAGE then
  273.         task_message()
  274.  
  275.     elsif current_task = TASK_DAMAGE then
  276.         task_dmg()
  277.  
  278.     elsif current_task = TASK_ENTER then
  279.         task_enter()
  280.  
  281.     elsif current_task = TASK_DEAD then
  282.         task_dead()
  283.  
  284.     elsif current_task = TASK_BSTAT then
  285.         task_bstat()
  286.  
  287.     end if
  288.     end while
  289.  
  290.     nk = c_remaining()
  291.     set_msg()
  292.     if nk = 0 then
  293.     victory_sound()
  294.     set_color(RED+BLINKING)
  295.     puts(CRT, "PROGRAMMERS THROUGHOUT THE GALAXY ARE EUPHORIC!!!!!")
  296.     delay(15)
  297.     else
  298.     printf(CRT, "%d C SHIPS REMAIN. YOU ARE DEAD. C RULES THE GALAXY!", nk)
  299.     delay(5)
  300.     end if
  301. end procedure
  302.  
  303. puts(1, "    Type n for novice level: ")
  304. init_delay() -- uses up some time - do it here
  305.  
  306. sequence in 
  307. in = gets(0)
  308. if find('n', in) then
  309.     level = 'n'
  310. else
  311.     level = 'e'    
  312. end if
  313.  
  314. cursor(NO_CURSOR)
  315. trek()
  316. position(25, 1)
  317. cursor(UNDERLINE_CURSOR)
  318. set_bk_color(BLACK)
  319. set_color(WHITE)
  320. puts(CRT, '\n')
  321.  
  322.  
  323.